home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / defoma / scripts / libwmf0.2-7.defoma < prev    next >
Text File  |  2007-05-06  |  3KB  |  129 lines
  1. # libwmf.defoma: Generate XML fontmap for libwmf.  -*- Perl -*-
  2.  
  3. @ACCEPT_CATEGORIES = qw(truetype type1);
  4.  
  5. package libwmf0_2_7;
  6. use Debian::Defoma::Common;
  7. use Debian::Defoma::Id;
  8.  
  9. my $PkgDir = "$ROOTDIR/libwmf0.2-7.d";
  10. my $Fontmap = "$PkgDir/fontmap";
  11. my $Id;
  12.  
  13. sub init {
  14.     $Id ||= defoma_id_open_cache();
  15.  
  16.     return 0;
  17. }
  18.  
  19. sub register {
  20.     my($font, @hints) = @_;
  21.  
  22.     my $hint = parse_hints_start(@hints);
  23.     defined($hint->{FontName}) or return 1;
  24.     my $fontname = $hint->{FontName};
  25.     $fontname =~ s/ .*//;
  26.     my $priority = $hint->{Priority} || 20;
  27.  
  28.     defoma_id_register($Id, type => 'real', font => $font,
  29.                id => $fontname, priority => $priority,
  30.                hints => join(' ', @hints));
  31.     if (defined($hint->{Alias})) {
  32.     for my $alias (split(/ /, $hint->{Alias})) {
  33.         defoma_id_register($Id, type => 'alias', font => $font,
  34.                    id => $alias, priority => $priority,
  35.                    origin => $fontname);
  36.     }
  37.     }
  38.  
  39.     return 0;
  40. }
  41.  
  42. sub unregister {
  43.     my($font) = @_;
  44.  
  45.     defoma_id_unregister($Id, type => 'alias', font => $font);
  46.     defoma_id_unregister($Id, type => 'real',  font => $font);
  47.  
  48.     return 0;
  49. }
  50.  
  51. sub term {
  52.     if ($Id) {
  53.     open(FONTMAP, ">$Fontmap.tmp") or die "$Fontmap.tmp: $!\n";
  54.  
  55.     print FONTMAP "<?xml version=\"1.0\"?>\n";
  56.     print FONTMAP "<fontmap>\n";
  57.  
  58.     for my $i (defoma_id_grep_cache($Id, 'installed', sorttype => 'p')) {
  59.         my $hint = parse_hints_start(defoma_id_get_hints($Id, $i));
  60.         my @attrs;
  61.  
  62.         push(@attrs, format => $Id->{e_category}->[$i]);
  63.  
  64.         push(@attrs, metrics => $hint->{AFM})
  65.         if defined($hint->{AFM});
  66.  
  67.         push(@attrs, glyphs => $Id->{e_font}->[$i]);
  68.  
  69.         push(@attrs, name => $Id->{e_id}->[$i]);
  70.  
  71.         my $fullname = $Id->{e_id}->[$i];
  72.         # ipa_font_sys_map() determines whether a font is italic by
  73.         # searching the full name.
  74.         $fullname .= " ($1)"
  75.         if $fullname !~ /Italic|Oblique/
  76.            && defined($hint->{Shape})
  77.            && $hint->{Shape} =~ /(Italic|Oblique)/;
  78.         push @attrs, fullname => $fullname;
  79.  
  80.         my $familyname;
  81.         if (defined($hint->{Family})) {
  82.         $familyname = $hint->{Family};
  83.         $familyname =~ tr/_/ /;
  84.         } else {
  85.         $familyname = $Id->{e_id}->[$i];
  86.         }
  87.         push(@attrs, familyname => $familyname);
  88.  
  89.         push(@attrs, weight => $hint->{Weight})
  90.         if defined($hint->{Weight});
  91.  
  92.         push(@attrs, version => '0.1');
  93.  
  94.         print FONTMAP "  <font";
  95.         while (my($attr, $value) = splice(@attrs, 0, 2)) {
  96.         print FONTMAP " $attr=\"$value\"";
  97.         }
  98.         print FONTMAP "/>\n";
  99.     }
  100.  
  101.     print FONTMAP "</fontmap>\n";
  102.  
  103.     close(FONTMAP) or die "$Fontmap.tmp: $!\n";
  104.  
  105.     # Atomically replace old fontmap.
  106.     rename("$Fontmap.tmp", $Fontmap) or die "$Fontmap: $!\n" ;
  107.  
  108.     defoma_id_close_cache($Id);
  109.     undef($Id);
  110.     }
  111.  
  112.     return 0;
  113. }
  114.  
  115. sub dispatch {
  116.     my($command, @args) = @_;
  117.  
  118.     if (my $code = __PACKAGE__->can($command)) {
  119.     return $code->(@args);
  120.     } else {
  121.     return 0;
  122.     }
  123. }
  124.  
  125. *truetype = *dispatch;
  126. *type1 = *dispatch;
  127.  
  128. 1;
  129.